perm filename HEADER.SAI[PNT,HE]2 blob
sn#373808 filedate 1978-08-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DEFINE VERSION!NUMBER = 5 COMMENT CHANGE THIS EACH TIME YOU MAKE ANY NEW
C00003 00003 defining constants and compile time macros to declare internal external etc
C00007 00004 defining default compile flags for $MAINPR
C00010 00005 ! IOSAIL debugging package
C00013 00006 ! global definitions of flags and other constants
C00017 00007 ! record class and pointer definitions
C00023 00008 ! procedure declarations
C00044 00009 ! variable declarations
C00051 00010 ! file requirements
C00053 ENDMK
C⊗;
DEFINE VERSION!NUMBER = 5 ; COMMENT CHANGE THIS EACH TIME YOU MAKE ANY NEW
CHANGES TO THIS FILE ***** ;
REQUIRE VERSION!NUMBER VERSION;
COMMENT defining constants and compile time macros to declare internal external etc;
DEFINE π = "3.141592653";
DEFINE ALT ="'775",
SEMC = "'73",
SP = "'40",
CR = "'15",
LF ="'12",
CRLF = "('15&'12)",
DLF = "('15&'12&'12)",
TAB = "'11",
FF = "'14",
! = "COMMENT ",
TV = "'13",
α = "BEGIN",
β = "END",
DQUOTE = "'42";
DEFINE TABDEF "[]" = [" "];
! if /nB is set in the command line then assume he wants a debugging parser;
require "<><>" delimiters;
IFC ¬DECLARATION(#DEBUG) THENC
DEFINE
DECIPHER_DEBUG(A)=<
ASSIGNC A=CVMS(COMPILER!BANNER)[2 TO ∞-1];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), LF, NULL, "IA"))+1 FOR ∞];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), TAB, NULL, "IA"))+1 FOR ∞];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), SP, NULL, "IA"))+1 FOR 1];
"A">;
IFC DECIPHER_DEBUG()="0"
THENC DEFINE #DEBUG=FALSE;
ELSEC DEFINE #DEBUG=TRUE;
EXTERNAL PROCEDURE BAIL;
ENDC
ENDC
DEFINE RCLASS "<>" = <RECORD_CLASS>;
DEFINE RPTR "<>" = <RECORD_POINTER>;
DEFINE RANY "<>" = <RECORD_POINTER(ANY_CLASS)>;
DEFINE ID_TYPE = 1,
INT_TYPE = 2,
REAL_TYPE = 3,
OPERATOR_TYPE = 4,
RES_TYPE = 5,
UNDECLARED_TYPE = 0;
! #TOKEN = ID_TYPE for identifier,
INT_TYPE for integer,
REAL_TYPE for real,
OPERATOR_TYPE for operators,
RES_TYPE for reserved words,
UNDECLARED_TYPE for not declared id's;
DEFINE #INDLK = 0; ! affix type = independent link;
DEFINE #NRGLK = 1; ! affix type = non rigid link;
DEFINE #RGDLK = 2; ! affix type = rigid link;
DEFINE #DEG = "(3.141592653/180.0)"; ! for radians/degrees conversion;
DEFINE DECLAR_VAR(DEC,I,E) "<>" =
< IFC I THENC INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
DEFINE DECLAR_PROC(DEC,I,E) "<>" =
< IFC I THENC FORWARD INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
DEFINE REQUIRE_LOADMODULE(FLAG, FILE) "<>" =
< IFC FLAG THENC
REQUIRE "FILE" LOAD_MODULE;
ENDC > ;
comment defining default compile flags for $MAINPR;
IFCR NOT DECLARATION(#HELP) THENC DEFINE #HELP = TRUE; ENDC
! the program is compiled without
help facilities (?, complete error explanations,
syntax of the istructions..);
IFCR NOT DECLARATION(#WRIST) THENC DEFINE #WRIST = TRUE; ENDC
IFCR NOT DECLARATION(#DISPL) THENC DEFINE #DISPL = TRUE; ENDC
! the program is without the display;
IFCR NOT DECLARATION(#OUTPT) THENC DEFINE #OUTPT = TRUE; ENDC
! the progaam is without file I/O;
IFCR NOT DECLARATION(#MOVE) THENC DEFINE #MOVE = TRUE; ENDC
! the program is without movements;
IFCR NOT DECLARATION(#INPUT) THENC DEFINE #INPUT = TRUE; ENDC
! the program is without arm interface;
IFCR NOT DECLARATION(#ARROW) THENC DEFINE #ARROW = TRUE; ENDC
! the program is without arm interface;
IFC ¬ #INPUT THENC REDEFINE #MOVE=FALSE; ENDC
IFC ¬ #DISPL THENC REDEFINE #ARROW=FALSE; ENDC
DEFINE #INDEF = 0; ! #INDEF for not defined direction in input;
DEFINE #SORRY "<>" = <("sorry, not implemented "&CRLF)>;
! used for non implemented parts message;
DEFINE #NOTYET "<>" = <("yarm not yet available "&CRLF)>;
! used for non implemented parts message;
DEFINE #VERSION "<>" = <("instruction not available in this POINTY version "&CRLF)>;
! used for different version message;
! IOSAIL debugging package ;
! following taken from IOSAIL.HDR[107,BTH] and modified;
! macros BUGON, BUGOFF, DEBUG, boolean !bugoff;
! boolean !bugoff;
! define BUGON = {!bugoff:=false};
! define BUGOFF = {!bugoff:=true};
define !bugoff = false; ! INITIALLY DEBUG ON;
define BUGON "{}" = {redefine !bugoff = true ; };
define BUGOFF "{}" = {redefine !bugoff = false ; };
define DEBUG (where,arglist) "{}" = { begin "DEBUG"
if not !bugoff then begin "do debug"
integer sf1,sf2;
getformat(sf1,sf2);
setformat(0,7);
redefine !bugind = 1;
print("DEBUG:where ");
ifc cvps(arglist) neq "("
thenc redefine !argl = {(arglist)};
elsec redefine !argl = {arglist}; endc
ifc length(cvms(!argl)) > 2 thenc
forlc !bugind := !argl doc {
print((cvps(!bugind) & "="),
ifc expr!type(!bugind) land check!type(string)
thenc """",!bugind,""""
elsec !bugind endc,
"; ");}
endc
endc
print(crlf);
setformat(sf1,sf2);
end "do debug";
end "DEBUG"};
! WARNING--!BUGIND and !ARGL are required by the debug package,
! and should not be otherwise used in this block
! to use:
! DEBUG(label,(i,j,k,l));
! alternate form:
! DEBUG(label,i);
! as long as i does not start with "(" this has the same effect as
! DEBUG(label,(i));
! global definitions of flags and other constants;
DEFINE #MIN = 1;
DEFINE #MAX = 7;
DEFINE #NTYPE = #MAX-#MIN +1; ! 7 data types= 7 classes of records;
DEFINE #LTYPE = 70; ! number of elements for each type;
DEFINE #LMT= #NTYPE*#LTYPE; ! # of postions in symtab;
DEFINE #SC = 1; ! SCALAR ;
DEFINE #VT = 2; ! VECTOR ;
DEFINE #RT = 3; ! ROT ;
DEFINE #TR = 4; ! TRANS ;
DEFINE #FR = 5; ! FRAME ;
DEFINE #MC = 6; ! MACRO ;
DEFINE #FN = 7; ! FUNCTION ;
DEFINE #EX = 8; ! EXPRESSION ;
DEFINE #SY = 9; ! SYMBOL ;
DEFINE #DTYPE= 10; ! # OF DATATYPES, INCREASE IF MORE RECORDS DEFINED;
DEFINE TTY_X=1; ! TTY input ;
DEFINE DSK_X=2 ; ! DSK input ;
DEFINE QUERY_X=3 ; ! QUERY input ;
DEFINE MESSAGE_X=4; ! MESSAGE input by MAIL from other prog ;
DEFINE WR_M = 1; ! DSK output for macros;
DEFINE ED_M = 2; ! TTY output for editing macros;
DEFINE DS_M = 3; ! TTY output for displaying macros;
IFCR NOT DECLARATION($MAINPR) THENC DEFINE $MAINPR = FALSE; ENDC
IFCR NOT DECLARATION($EXPR) THENC DEFINE $EXPR = FALSE; ENDC
IFCR NOT DECLARATION($OPERAT) THENC DEFINE $OPERAT = FALSE; ENDC
IFCR NOT DECLARATION($PARSER) THENC DEFINE $PARSER = FALSE; ENDC
IFCR NOT DECLARATION($$HELP) THENC DEFINE $$HELP = FALSE; ENDC
IFCR NOT DECLARATION($INPOUT) THENC DEFINE $INPOUT = FALSE; ENDC
IFCR NOT DECLARATION($OUTPUT) THENC DEFINE $OUTPUT = FALSE; ENDC
IFCR NOT DECLARATION($DISPLY) THENC DEFINE $DISPLY = FALSE; ENDC
IFCR NOT DECLARATION($INIT) THENC DEFINE $INIT = FALSE; ENDC
IFCR NOT DECLARATION($EPP) THENC DEFINE $EPP = FALSE; ENDC ! ****** ;
IFCR NOT DECLARATION($MOVARM) THENC DEFINE $MOVARM = FALSE; ENDC
IFCR NOT DECLARATION($ARMSOL) THENC DEFINE $ARMSOL = FALSE; ENDC
IFC ¬($MAINPR OR $EXPR OR $OPERAT OR $PARSER OR $$HELP OR $INPOUT OR $OUTPUT OR $DISPLY OR $INIT OR $MOVARM OR $ARMSOL) THENC
REQUIRE "
**********PROGRAM DOESN'T HAVE ID ****************
" MESSAGE;
ENDC
! record class and pointer definitions;
DECLAR_VAR(<RCLASS SYMBOL (STRING PNAME;RANY OBJECT; INTEGER NUSEDBY,NUSES;
BOOLEAN VALID; RANY ARRAY USEDBY,USES)>,
$MAINPR, $PARSER∨$OPERAT∨$INPOUT∨$EXPR∨$DISPLY∨$INIT);
DECLAR_VAR(<RPTR (SYMBOL) ARRAY $YMTAB[0:#LMT]>, $MAINPR, $INPOUT∨$DISPLY);
! DECLAR_VAR(<INTEGER ARRAY PORDER[0:#LMT]>, $MAINPR, $INPOUT∨$DISPLY);
DECLAR_VAR(<INTEGER ARRAY $ENTRY[0:#NTYPE]>, $MAINPR, $INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RCLASS SCALAR (REAL VALUE)>, $MAINPR, $EXPR∨$OPERAT∨$PARSER∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RCLASS VECTOR (REAL XC,YC,ZC)>, $MAINPR, $EXPR∨$OPERAT∨$PARSER∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RCLASS FRAME (STRING PNAME;
RPTR (FRAME) DAD,SON,EBRO,YBRO; INTEGER HOWLINKED;
REAL ARRAY XF)>, $MAINPR,
$EXPR∨$OPERAT∨$PARSER
∨$INPOUT∨$DISPLY∨$MOVARM
∨$ARMSOL∨$INIT);
DECLAR_VAR(<RCLASS ROT (REAL ARRAY XF)>, $MAINPR, $EXPR∨$OPERAT∨$PARSER∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RCLASS TRANS(REAL ARRAY XF)>, $MAINPR, $EXPR∨$OPERAT∨$PARSER∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RCLASS EXPR(RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME,EXPR,SYMBOL)PTR;
INTEGER TYPE;
RPTR(EXPR)NEXT)>, $MAINPR, $EXPR∨$PARSER∨$DISPLY);
DECLAR_VAR(<RCLASS PLIST(STRING PARAM;
RPTR(PLIST) NEXTP)>, $MAINPR, $PARSER∨$INPOUT);
DECLAR_VAR(<RCLASS MACRO(STRING BODY;
INTEGER NPARAM;
RPTR(PLIST) PARLST)>, $MAINPR, $PARSER∨$INPOUT);
DECLAR_VAR(<RCLASS FUNCTION(INTEGER NARGS;
STRING HEAD; ! first part of declaration ;
STRING BODY;
STRING ARRAY ARGNAME;
INTEGER ARRAY ARGTYPE;
RPTR(EXPR,SCALAR,VECTOR,ROT,TRANS,FRAME,FUNCTION) ARRAY PTR;
RPTR(EXPR)EXPR;
INTEGER TYPE)>, $MAINPR, $EXPR∨$PARSER∨$DISPLY);
DECLAR_VAR(<RCLASS TREE( RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME,FUNCTION,SYMBOL)DATA;
INTEGER DTYPE)>, $MAINPR, $PARSER∨$EXPR);
DECLAR_VAR(<RPTR (FUNCTION) FN_CUR>, FALSE, FALSE);
! pointers to predeclared symbols;
DECLAR_VAR(<RPTR(SYMBOL)HANDB,HANDY,INCHES,DEG,INCH,DEGREE,DEGRES>,
$MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
! for scalars BHAND,YHAND;
DECLAR_VAR(<RPTR(SCALAR) S_BHAND,S_YHAND>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RPTR(SYMBOL)XHAT,YHAT,ZHAT,NILVECT>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
! for vectors XHAT,YHAT,ZHAT,NILVECT;
DECLAR_VAR(<RPTR(VECTOR) V_XHAT,V_YHAT,V_ZHAT,V_NILVECT>,
$MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RPTR(SYMBOL)WORLD,BARM,YARM,BPARK,YPARK,BGRASP,POINTER>,
$MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RPTR(FRAME)F_BARM,F_YARM,F_BGRASP,F_POINTER,F_FID,F_WRLD>,
$MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$MOVARM∨$INIT);
DECLAR_VAR(<RPTR(FRAME)F_BPARK,F_YPARK>, $MAINPR, $EXPR∨$INPOUT∨$DISPLY∨$ARMSOL∨$INIT);
! for frames STATION,BARM,YARM,BPARK,YPARK,POINTER;
DECLAR_VAR(<RPTR(SYMBOL)NILROTN>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RPTR(ROT) R_NILROTN>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
! for rotation NILROTN;
DECLAR_VAR(<RPTR(SYMBOL)NILTRANS>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
DECLAR_VAR(<RPTR(TRANS) T_NILTRANS>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
! for trans NILTRANS;
DECLAR_VAR(<RPTR(FRAME) F_ARM>, $MAINPR, $OPERAT∨$INPOUT∨$DISPLY∨$INIT);
! procedure declarations ;
! **** MAIN PROGRAM PROCEDURES ****** ;
DECLAR_PROC(<procedure outdpw (string mess; integer string_pos, pp_pos)>,
FALSE, $MAINPR);
DECLAR_PROC(<PROCEDURE ADDSYMUSED(RPTR(SYMBOL)SYM,USES)>,$MAINPR, $EXPR);
DECLAR_PROC(<RPTR(TREE) PROCEDURE DCDSYM(STRING SYMB)>, $MAINPR, $PARSER∨$EXPR);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE CHECK(STRING SYMB; INTEGER NM)>,
$MAINPR, $PARSER);
DECLAR_PROC(<INTEGER PROCEDURE DECSTR(STRING S)>, $MAINPR, $PARSER∨$EXPR);
DECLAR_PROC(<PROCEDURE ERROR(STRING ERR1,ERR2(NULL))>, $MAINPR, $PARSER∨$EXPR∨$INPOUT);
DECLAR_PROC(<PROCEDURE ESC_P>, $MAINPR, $PARSER∨$INPOUT);
DECLAR_PROC(<PROCEDURE ABORT1(STRING NAME,ERROR(NULL))>, $MAINPR, $OPERAT∨$INPOUT∨$MOVARM∨$PARSER);
DECLAR_PROC(<STRING PROCEDURE FRCVER(STRING FILE)>, $MAINPR∧#OUTPT, $INPOUT);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE CHECKTOT(STRING SYMB;REFERENCE INTEGER NM)>,
$MAINPR, $EXPR);
DECLAR_PROC(<PROCEDURE READ_ARM(INTEGER ARM)>, $MAINPR, $MOVARM);
DECLAR_PROC(<PROCEDURE READ_BLUE>, $MAINPR, $EXPR);
DECLAR_PROC(<PROCEDURE UPDATE>, $MAINPR, $PARSER);
DECLAR_PROC(<RPTR(TRANS) PROCEDURE DOTREXP(REAL W,PH,TH,X,Y,Z)>,
$MAINPR, $INIT);
DECLAR_PROC(<RPTR (SCALAR,VECTOR,ROT,FRAME,TRANS) PROCEDURE MK_REC(INTEGER TYPE)>,
$MAINPR, $OPERAT∨$EXPR∨$INIT);
DECLAR_PROC(<RPTR (SYMBOL) PROCEDURE ENSYM(STRING SYMB;INTEGER NM;RANY VAL)>,
$MAINPR, $INIT);
DECLAR_PROC(<PROCEDURE AFX_NODE(RPTR(FRAME)N,D;INTEGER HOW)>,
$MAINPR, $INIT);
DECLAR_PROC(<SIMPLE PROCEDURE ESC_I>, $MAINPR, $PARSER);
! **** EXPR PROCEDURES ******* ;
DECLAR_PROC(<RPTR (EXPR) PROCEDURE MK_EXPR(RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME,EXPR,FUNCTION,SYMBOL) PTR;
INTEGER TYPE; RPTR(EXPR) EX(NULL_RECORD))>,
$EXPR, $MAINPR);
DECLAR_PROC(<RPTR(TREE)PROCEDURE FNEXPR(RPTR(FUNCTION)F; REFERENCE STRING FBODY;
REFERENCE RPTR(EXPR)SYMUSED)>,
$EXPR, $MAINPR);
DECLAR_PROC(<RECURSIVE RPTR(TREE)PROCEDURE GTEXPR>, $EXPR, $MAINPR);
DECLAR_PROC(<RPTR(TREE) PROCEDURE NWTREE(RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME,SYMBOL)R;
INTEGER T)>, $EXPR, $MAINPR∨ $PARSER);
! *** PARSER PROCEDURES **** ;
DECLAR_PROC(<RECURSIVE PROCEDURE GTOKEN(BOOLEAN NONSTOP(TRUE))>,
$PARSER, $MAINPR∨$EXPR);
! if response is left out ASKUSER will wait for terminal input;
DECLAR_PROC(<PROCEDURE ASKUSER(STRING RESPONSE(null))>, $PARSER, $MAINPR∨$INPOUT);
DECLAR_PROC(<PROCEDURE PUSHDEVSTACK>, $PARSER, $MAINPR);
DECLAR_PROC(<PROCEDURE POPDEVSTACK>, $PARSER, $MAINPR);
DECLAR_PROC(<PROCEDURE MTYDEVSTACK>, $PARSER, $MAINPR);
DECLAR_PROC(<PROCEDURE NEWLINE>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE BOOLEAN PROCEDURE FINAL>, $PARSER, $MAINPR);
DECLAR_PROC(<PROCEDURE READTO(STRING S)>, $PARSER, $MAINPR);
DECLAR_PROC(<STRING PROCEDURE NAMEFILE>, $PARSER, $MAINPR∨$INPOUT);
DECLAR_PROC(<SIMPLE STRING PROCEDURE WRTCODE>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE FROMPART>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE AXIS_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE DEV_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE ARM_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE HAND_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE INTO_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE LPAR_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE RPAR_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE SEMICOL_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE TO_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE BY_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE MVFR_READ>, $PARSER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE IDF_READ>, $PARSER, $MAINPR);
! **** HELP PROCEDURES **** ;
DECLAR_PROC(<PROCEDURE HLPMSG(INTEGER HELP1,HELP2(0))>, $$HELP, $MAINPR∧#HELP);
DECLAR_PROC(<PROCEDURE HLPDO(STRING ANSWER)>, $$HELP, $MAINPR∧#HELP);
! **** OPERAT PROCEDURES **** ;
DECLAR_PROC(<SIMPLE PROCEDURE INVXFX(REAL ARRAY A,B,C)>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE XFINV(REAL ARRAY A,B)>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE XFXF(REAL ARRAY A,B,C)>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE XFVT(REAL ARRAY A,B,C)>, $OPERAT, $EXPR);
DECLAR_PROC(<PROCEDURE DECODE (REAL ARRAY XF; REFERENCE REAL A,B,C)>,
$OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(<PROCEDURE EULERO(REAL ARRAY XF;REFERENCE REAL W,PH,TH)>,
$OPERAT, $EXPR∨$OUTPUT);
DECLAR_PROC(<SIMPLE PROCEDURE XYZROT(REAL ARRAY XF; REAL ANGLE,CX,CY,CZ)>,
$OPERAT, $EXPR);
DECLAR_PROC(<SIMPLE PROCEDURE SETROT(REAL ARRAY XF;REAL W,PH,TH)>,
$OPERAT,$EXPR∨$MAINPR);
DECLAR_PROC(<RPTR (TRANS)PROCEDURE VVVTR (RPTR(VECTOR)V1,V2,V3;
INTEGER F_AXIS(2),S_AXIS(0))>, $OPERAT,$EXPR∨$MAINPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FSQRT(REAL VAL)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FINT(REAL VAL)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FSIN(REAL VAL)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FCOS(REAL VAL)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FASIN(REAL VAL)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FACOS(REAL VAL)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR)PROCEDURE FATAN2(REAL VAL1,VAL2)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(SCALAR) PROCEDURE SMAKE(REAL S1)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(ROT)PROCEDURE RMAKE(RPTR(VECTOR)AX;REAL ANGLE)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(ROT)PROCEDURE VRMAKE(RPTR(VECTOR)AX,AY,AZ)>, $OPERAT,$EXPR);
DECLAR_PROC(<RPTR(FRAME) PROCEDURE FMAKE(RPTR(ROT)TMPRT;RPTR(VECTOR)TMPVT)>,
$OPERAT,$EXPR);
DECLAR_PROC(< RPTR(TRANS) PROCEDURE TMAKE(RPTR(ROT)TMPRT;RPTR(VECTOR)TMPVT)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE VMAKE(REAL R1,R2,R3)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR (FRAME)PROCEDURE CONSF(RPTR(FRAME)F1,F2,F3)>,$OPERAT, $EXPR);
DECLAR_PROC(< RPTR (FRAME)PROCEDURE CONSV(RPTR(VECTOR)F1,F2,F3)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE NORMVT(RPTR(VECTOR)EL)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE NMSUB(RPTR(VECTOR) V1,V2)>,$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE NMCROS(RPTR(VECTOR)V1,V2)>,$OPERAT, $EXPR);
DECLAR_PROC(< SIMPLE PROCEDURE GETVTV(RPTR(VECTOR) EL; REAL ARRAY COMP)>,
$OPERAT, $EXPR);
DECLAR_PROC(< SIMPLE PROCEDURE PUTVTV (RPTR(VECTOR) EL; REAL ARRAY COMP)>,
$OPERAT, $EXPR);
DECLAR_PROC(< PROCEDURE LINKFR(RPTR(FRAME) N,D);>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< PROCEDURE UNLINK(RPTR(FRAME) N)>, $OPERAT, $EXPR∨$MAINPR);
! DECLAR_PROC(< RPTR(ROT)PROCEDURE RTRTOP(RPTR(ROT)R1,R2)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE FPOS(RPTR(FRAME)SEC)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE TPOS(RPTR(TRANS)XFE)>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< RPTR(ROT)PROCEDURE FORIEN(RPTR(FRAME)SEC)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(SCALAR)PROCEDURE SMOD(REAL RIGHT)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(SCALAR)PROCEDURE VMOD(RPTR(VECTOR)RIGHT)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR)PROCEDURE RELVT(RPTR(VECTOR) VET;RPTR(FRAME) RELFR)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR)PROCEDURE WRTVT(RPTR(VECTOR) VET;RPTR(FRAME) RELFR)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(TRANS) PROCEDURE ABSLOC(RPTR(FRAME) ND)>,
$OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< RPTR(FRAME) PROCEDURE RELFR(RPTR(FRAME)DAD;RPTR(TRANS)RELPOS)>,
$OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< PROCEDURE ABSSET(RPTR(FRAME) FRA;RPTR(TRANS)XFE)>,
$OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< PROCEDURE RELSET(RPTR(FRAME)FRA;RPTR(TRANS)XFE)>, $OPERAT, $EXPR);
DECLAR_PROC(< PROCEDURE SETABS(RPTR(FRAME) N;REAL ARRAY XF)>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< PROCEDURE ABSXF(RPTR(FRAME) N;REAL ARRAY XF)>, $OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< RPTR(VECTOR)PROCEDURE OPSCVT(REAL NUM;RPTR(VECTOR)VAL;STRING OP)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(SCALAR)PROCEDURE OPSCAL(REAL VAL1,VAL2;STRING OP)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(SCALAR)PROCEDURE OPDOT(RPTR(VECTOR)VAL1,VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR)PROCEDURE OPVET(RPTR(VECTOR) VAL1,VAL2;STRING OP)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(ROT)PROCEDURE OPRTRT(RPTR(ROT)VAL1,VAL2)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR)PROCEDURE OPRTVT(RPTR(ROT)VAL1;RPTR(VECTOR)VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE OPFRVT(RPTR(VECTOR) VAL1;RPTR(FRAME)VAL2;STRING OP)>,
$OPERAT, $EXPR∨$MAINPR);
DECLAR_PROC(< RPTR(VECTOR) PROCEDURE OPVTFR(RPTR(FRAME) VAL1;RPTR(VECTOR)VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(VECTOR)PROCEDURE OPTRVT(RPTR(TRANS)VAL1;RPTR(VECTOR)VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(TRANS)PROCEDURE OPFRFR(RPTR(FRAME)VAL1,VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(TRANS)PROCEDURE OPTRTR(RPTR(TRANS)VAL1,VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME) PROCEDURE OPFR(RPTR(FRAME)VAL1,VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE OPTRFR(RPTR(TRANS)VAL1;RPTR(FRAME)VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE OPFRTR(RPTR(FRAME)VAL1;RPTR(TRANS)VAL2)>,
$OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE ORIENU(RPTR(FRAME)VAL1)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE ORIEN$(RPTR(FRAME)VAL1)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE ORIEND(RPTR(FRAME)VAL1)>, $OPERAT, $EXPR);
DECLAR_PROC(< RPTR(FRAME)PROCEDURE ORIENα(RPTR(FRAME)VAL1)>, $OPERAT, $EXPR);
! **** OUTPUT PROCEDURES **** ;
IFC $MAINPR∨$OUTPUT∨$INPOUT∨$EXPR∨$DISPLY THENC
DECLAR_PROC(<SIMPLE STRING PROCEDURE CVGX(REAL R)>, $OUTPUT, $INPOUT∨$MAINPR∨$EXPR∨$DISPLY);
DECLAR_PROC(<STRING PROCEDURE STR_RT(REAL ARRAY XF;INTEGER NUM(1))>,
$OUTPUT,$INPOUT∨$MAINPR∨$EXPR∨$DISPLY);
DECLAR_PROC(<SIMPLE STRING PROCEDURE STR_VT(REAL X,Y,Z;INTEGER NUM(1))>,
$OUTPUT,$INPOUT∨$MAINPR∨$EXPR∨$DISPLY);
DECLAR_PROC(<SIMPLE STRING PROCEDURE STR_TR(REAL ARRAY XF;INTEGER ROT(1),VECT(1))>,
$OUTPUT,$INPOUT∨$MAINPR∨$EXPR∨$DISPLY);
ENDC
! ***** DISPLY ROUTINES ***** ;
IFC $DISPLY∨($MAINPR∧(#OUTPT∨#DISPL)) THENC
DECLAR_PROC(<PROCEDURE DPYOUT(INTEGER POG)>, FALSE∧$DISPLY, (#OUTPT∨#DISPL)∧$MAINPR);
DECLAR_PROC(<SIMPLE PROCEDURE INIDPY>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<SIMPLE PROCEDURE DPYDRAW>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<SIMPLE PROCEDURE DPYFREE>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<SIMPLE PROCEDURE OUTDPY>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<STRING PROCEDURE DPY_STRING(INTEGER TYPE)>, $DISPLY, #OUTPT∨#DISPL);
DECLAR_PROC(<RECURSIVE STRING PROCEDURE FRTREE(RPTR(FRAME) ND;INTEGER DEPTH)>,
$DISPLY, #OUTPT∨#DISPL);
! # of characters for frame tree;
DECLAR_VAR(<INTEGER $NCHAR>, $DISPLY, #OUTPT∨#DISPL);
ENDC
! ****** $INPOUT ROUTINES ******* ;
IFC ($MAINPR∧#OUTPT)∨$INPOUT∨$DISPLY THENC
DECLAR_PROC(<PROCEDURE FCLOSE>, $INPOUT, #OUTPT);
DECLAR_PROC(<PROCEDURE AL_CLOSE(STRING FILE )>, $INPOUT, #OUTPT);
DECLAR_PROC(<STRING PROCEDURE MACDYS(RPTR(SYMBOL) TMAC)>, $INPOUT, $DISPLY∨$MAINPR);
DECLAR_PROC(<PROCEDURE WRITECODE(STRING FILE;RPTR(SYMBOL) ELEMENT;
INTEGER DTYPE;STRING DEFPR)>, $INPOUT, #OUTPT);
DECLAR_PROC(<STRING PROCEDURE EWDYSCODE(RPTR(SYMBOL) EL1)>, $INPOUT, $MAINPR);
DECLAR_PROC(<PROCEDURE EWDSPL(STRING SSSS; INTEGER TYPOUT)>, $INPOUT, $MAINPR);
DECLAR_PROC(<PROCEDURE PWDSPL(STRING SSSS)>, $INPOUT, $MAINPR);
DECLAR_PROC(<PROCEDURE TTYSAVE>, $INPOUT, #OUTPT);
DECLAR_PROC(<STRING PROCEDURE FILE_STRING>, $INPOUT, #OUTPT);
DECLAR_PROC(<INTEGER PROCEDURE ISFILE(STRING FILE)>, $INPOUT, #OUTPT);
DECLAR_PROC(<STRING PROCEDURE DAT_STR>, $INPOUT, #OUTPT);
ENDC
DECLAR_PROC(<PROCEDURE UDATEFILE(INTEGER CHAN)>, $INPOUT, $PARSER);
! ******* INIT ROUTINES ********** ;
DECLAR_PROC(<PROCEDURE INIT>, $INIT, $MAINPR);
! ********** MOVARM PROCEDURES ****** ;
DECLAR_PROC(<PROCEDURE DRIVE(INTEGER ARM,JOINT,ABSREL; REAL DIF,TT(1.5))>,
$MOVARM, $MAINPR∧#MOVE);
DECLAR_PROC(<PROCEDURE MMOVE(RPTR(FRAME)ARRAY FRS; INTEGER NUMDEST(1); REAL TT(1.5))>,
$MOVARM, $MAINPR∧#MOVE);
DECLAR_PROC(<PROCEDURE CENTER(INTEGER ARM)>,
$MOVARM, $MAINPR∧#MOVE);
! ******** ARMSOL ROUTINES ********** ;
DECLAR_PROC(<INTEGER PROCEDURE ARMSOL(INTEGER ARM; REAL ARRAY B; RPTR(FRAME)T)>,
$ARMSOL, $MOVARM);
! ******** TLKEF3 ROUTINES AND FAITRG ***** ;
DECLAR_PROC(<PROCEDURE DTERMS(REAL ARRAY DD;REFERENCE REAL TH;INTEGER ARM)>,
FALSE, $MOVARM);
DECLAR_PROC(<PROCEDURE TLKEF3(INTEGER MASTER;INTEGER ARRAY DATA)>,
FALSE, $MOVARM);
! ******** WRIST ROUTINES *************;
DECLAR_PROC(<INTEGER PROCEDURE RWRIST(STRING COMMAND; INTEGER VAL(0); STRING FILENAME(NULL))>,
FALSE, $MAINPR∧#WRIST);
! variable declarations ;
! **** BREAK TABLES ****** ;
DECLAR_VAR(<INTEGER $RETAB,$SKTAB,$SPCTAB,$SCNTAB,$NUMTAB,$ALFTAB,$FFTAB,
$DSHTAB,$CRTAB>,
$MAINPR, $PARSER∨$INIT);
DECLAR_VAR(<INTEGER $DPYTAB>,
$MAINPR, $PARSER∨$INIT∨$DISPLY);
DECLAR_VAR(<INTEGER $ERRTAB>, $MAINPR, $PARSER∨$INPOUT∨$INIT);
DECLAR_VAR(<INTEGER $BSKTAB>, $MAINPR, $PARSER∨$INPOUT∨$INIT∨$OUTPUT);
! **** DEFAULT MOVE FROM PREVIOUS **** ;
DECLAR_VAR(<STRING OLDOBJ>, $MAINPR, $PARSER);
! **** I/O TO POINTY ******* ;
! ESCAPE_I FLAG;
DECLAR_VAR(<BOOLEAN $ESC_I>, $MAINPR, $PARSER);
! if true output is required;
DECLAR_VAR(<BOOLEAN $OUT>, $MAINPR, $PARSER∨$INPOUT);
! if true read from disk file ;
DECLAR_VAR(<INTEGER $TTYCH>, $MAINPR, $PARSER∨$INPOUT);
! name of file for teletype input ;
DECLAR_VAR(<STRING $TTYFL>, $MAINPR, $INPOUT∨$INIT∨$DISPLY);
! total number of files defined ;
DECLAR_VAR(<INTEGER $TOTFL>, $MAINPR, $INPOUT∨$INIT);
! last file used for output ;
DECLAR_VAR(<STRING $ALFL>, $MAINPR, $INPOUT∨$INIT);
! current i/o device ;
DECLAR_VAR(<INTEGER DEVICE>, $MAINPR, $PARSER∨$INIT);
! end of file ? ;
DECLAR_VAR(<INTEGER $EOF>, $MAINPR, $PARSER∨$INPOUT);
! input channel for file input ;
DECLAR_VAR(<INTEGER $INPCH>, $MAINPR, $PARSER);
! **** DISPLAY ***** ;
! vertical position of the arrow;
DECLAR_VAR(<INTEGER $ARROW>, $MAINPR, $DISPLY);
! flag to update display ;
DECLAR_VAR(<INTEGER $ALLOW>, $MAINPR, $PARSER∨$INIT);
! strings for various parts of the display ;
DECLAR_VAR(<STRING ARRAY $DISPLAYLIST[#MIN:#MAX]>, $MAINPR, $DISPLY);
IFC ($MAINPR ∨ $DISPLY) THENC
DEFINE $SCLST= <$DISPLAYLIST[#SC]>,
$VTLST= <$DISPLAYLIST[#VT]>,
$RTLST= <$DISPLAYLIST[#RT]>,
$TRLST= <$DISPLAYLIST[#TR]>,
$FRLST= <$DISPLAYLIST[#FR]>,
$FNLST= <$DISPLAYLIST[#FN]>,
$MCLST= <$DISPLAYLIST[#MC]>;
ENDC
DECLAR_VAR(<STRING $OULST,$DFLST>, $MAINPR, $INPOUT∨$DISPLY);
! **** SCANNER VARIABLES AND PARAMETERS **** ;
! the token itself ;
DECLAR_VAR(<STRING TOKEN>, $MAINPR, $PARSER∨$EXPR);
! type of last token read by GTOKEN;
DECLAR_VAR(<INTEGER #TOKEN>, $MAINPR, $PARSER∨$EXPR);
! index telling what type of reserved word ;
DECLAR_VAR(<integer res_class>, $PARSER, $MAINPR);
! true if the next token to be read is yet in TOKEN;
DECLAR_VAR(<BOOLEAN STOKEN>, $MAINPR, $PARSER∨$EXPR∨$INIT);
! more info on TOKEN ;
DECLAR_VAR(<INTEGER TOKENCLASS,TOKENINDEX>, $EXPR, $PARSER∨$MAINPR);
! pointer too relevant record in the symbol table ;
DECLAR_VAR(<RPTR(SCALAR,SYMBOL) TOKENPTR>,
$EXPR, $PARSER∨$MAINPR);
! current and remaining part of current line ;
DECLAR_VAR(<STRING $CLNE,$CLINR>, $MAINPR, $PARSER∨$INPOUT);
! prevent macro expansion;
DECLAR_VAR(<BOOLEAN NOEXPAND>, $MAINPR, $PARSER);
! output * or ****>>> depending on new statement ;
DECLAR_VAR(<BOOLEAN STBEGIN>, $MAINPR, $PARSER);
! do we want to print out the file being read in? ;
DECLAR_VAR(<BOOLEAN NEWFILE,FILEPRINT>, $MAINPR, $PARSER);
! ***** MISCELLANEOUS VARIABLES ******* ;
DECLAR_VAR(<REAL $EPS>, $MAINPR, $OPERAT∨$INIT∨$OUTPUT);
DECLAR_VAR(<INTEGER $ROW>, $MAINPR, FALSE);
DECLAR_VAR(<STRING $BLANK>, $MAINPR, $INPOUT∨$INIT∨$DISPLY);
DECLAR_VAR(<INTEGER $BRCHR>, $MAINPR, $INPOUT∨$OUTPUT);
DECLAR_VAR(<STRING $USERNAME>, $MAINPR, $INIT);
DECLAR_VAR(<STRING ARRAY $SYNMSG[0:35]>, $MAINPR∧FALSE, $PARSER);
DECLAR_VAR(<STRING ARRAY ARMERR[1:6]>, $MAINPR∧#MOVE∧FALSE, $MOVARM∨$EXPR);
DECLAR_VAR(<REAL ARRAY BANGLE,YANGLE[1:7]>, $MAINPR∧#MOVE∧FALSE,
$MOVARM);
DECLAR_VAR(<SAFE REAL ARRAY LOSTOP, HISTOP, TIMFAC[0:1,1:7]>, $ARMSOL∧FALSE, $MOVARM);
DECLAR_VAR(<STRING ARRAY $DTYPE[0:7]>, $EXPR∧FALSE, $MAINPR);
DECLAR_VAR(<STRING ARRAY $WRMSG[1:3]>, #WRIST∧FALSE, $MAINPR∧#WRIST);
DECLAR_VAR(<INTEGER ARMFALSE,$GTEXPR>, $MAINPR, $EXPR);
! file requirements;
REQUIRE_LOADMODULE($MAINPR∧#DISPL, <DISPLY[PNT,he]>);
REQUIRE_LOADMODULE($MAINPR∧#DISPL, <OUTDPW[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#OUTPT, <INPOUT[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <OUTPUT[PNT,he]>);
REQUIRE_LOADMODULE($MAINPR∧#HELP, <HELP[PNT,he]>);
REQUIRE_LOADMODULE($MAINPR, <EXPR[PNT,MSM]>);
REQUIRE_LOADMODULE($MAINPR, <PARSE[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#ARROW, <ARROW[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <OPERAT[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR, <INIT[PNT,he]>);
REQUIRE_LOADMODULE($MAINPR∧#MOVE, <MOVARM[PNT,HE]>);
REQUIRE_LOADMODULE($MAINPR∧#WRIST, <WRIST[PNT,HE]>);
REQUIRE_LOADMODULE($MOVARM, <BEJCZY[PNT,HE]>);
REQUIRE_LOADMODULE($MOVARM, <TLKEF3[PNT,HE]>);
REQUIRE_LOADMODULE($MOVARM, <ARMSOL[PNT,HE]>);
REQUIRE_LOADMODULE($MOVARM, <TLKF5B[PNT,HE]>);
REQUIRE_LOADMODULE($ARMSOL, <FAITRG[PNT,HE]>);
IFC $EXPR OR $MAINPR OR $OPERAT THENC
REQUIRE "OPDECL.SAI[pnt,he]" SOURCE_FILE;
ENDC
REQUIRE "[][]" DELIMITERS;